module strutils
   integer, parameter :: c_FloatStrLen = 30
contains


function lrtrim(s)
   implicit none
   character(len = len_trim(adjustl(s))) :: lrtrim
   character(len = *) :: s
   lrtrim = trim(adjustl(s))
end function lrtrim


function inttostr(i)
   implicit none
   character(len = 30) :: inttostr
   integer, intent(in) :: i
   write(inttostr, *) i
end function inttostr


function strtoint(s)
   implicit none
   integer :: strtoint
   character(len = *), intent(in) :: s
   if (lrtrim(s) == "") then
      strtoint = 0
   else
      read(s, *) strtoint
   end if
end function strtoint


function ScanStr(Str, C)
   implicit none
   integer :: ScanStr
   character(len = *), intent(in) :: Str
   character(len = 1), intent(in) :: C
   integer :: i
   ScanStr = -1
   do i = 1, len(Str)
      if (Str(i:i) == C(1:1)) then
         ScanStr = i
         return
      endif
   end do
end function ScanStr


function floattostrex(f, ndec) 
   implicit none
   character(len = c_FloatStrLen) :: floattostrex
   double precision :: f
   integer :: ndec
   character(len = 10) :: fstr 
   fstr = '(f30.' // lrtrim(inttostr(ndec)) // ')'
   write(floattostrex, lrtrim(fstr)) f
end function floattostrex

 
function floattostr(f, NumDig, NumDec)
   implicit none
   character(len = c_FloatStrLen) :: floattostr
   double precision, intent(in) :: f
   integer :: i, decp, expp, plusp, minusp, start, last, NumRemovals, TotWidth
   integer, intent(out), optional :: NumDig
   integer, intent(out), optional :: NumDec
   logical :: HasFracPart = .false.
   write(floattostr, '(f30.7)') f
   if (.not. (present(NumDig) .or. present(NumDec))) return
   TotWidth = len_trim(adjustl(floattostr))
   NumDig = TotWidth 
   decp = ScanStr(floattostr, ".")
   expp = ScanStr(floattostr, "E")
   if (decp == -1) return
   start = decp  
   last = c_FloatStrLen
   if (expp /= -1) then
      last = expp - 1
   else 
      plusp = ScanStr(floattostr, "+")
      if (plusp /= -1) then
         last = plusp - 1
         expp = plusp 
      else 
         minusp = ScanStr(floattostr, "-")
         if (minusp /= -1) then
            last = plusp - 1
            expp = minusp 
         endif
      endif
   endif
   NumRemovals = 0
   NumDec = 0
   NumDig = 0
   do i = last, start, -1
      select case(floattostr(i:i))
         case (' ', '.', '0') 
            floattostr(i:i) = ' '
            NumRemovals = NumRemovals + 1
         case default
            NumDec = i - start
            TotWidth = i 
            exit
      end select
   enddo
   do i = start - 1, 1, -1
      if (floattostr(i:i) == ' ') exit
      NumDig = NumDig + 1
   enddo
   if (expp /= -1) then
      do i = expp, c_FloatStrLen
         floattostr(i - NumRemovals : i - NumRemovals) = floattostr(i:i)
         floattostr(i:i) = ' '
      enddo   
   endif
end function floattostr


subroutine GetNumberFormatInMatrix(M, NumDig, NumDec)
   implicit none
   double precision, pointer :: M(:,:) 
   integer, intent(out) :: NumDig, NumDec
   integer :: NumDecimalsInMatrix, I, J, Dig, Dec
   character(len = c_FloatStrLen) :: str
   NumDec = 0
   NumDig = 0
   do I = 0, size(M, 1) - 1
      do J = 0, size(M, 2) - 1
         str = floattostr(M(I, J), Dig, Dec)
         NumDig = max(NumDig, Dig)  
         NumDec = max(NumDec, Dec)  
      enddo
   enddo
end subroutine GetNumberFormatInMatrix


function strtofloat(s)
   implicit none
   double precision :: strtofloat
   character(len = *), intent(in) :: s
   if (lrtrim(s) == "") then
      strtofloat = 0
   else
      read(s, *) strtofloat
   end if
end function strtofloat


function strcmp(sStr1, sStr2)
!Comparison of two C strings or a C string and Fortran
!string. Stops comparison when it finds \0.

   character*(*), intent(in):: sStr1
   character*(*), intent(in):: sStr2
   logical :: strcmp
   integer :: Len1, Len2, k
   Len1 = len(sStr1)
   Len2 = len(sStr2)
   strcmp = .false. 
   k = 1
   do
!      print *, k, Len1, Len2; call system('pause')
      if (Len1 /= Len2) then
         return
      elseif (k > Len1 .or. k > Len2) then
         return
      elseif (sStr1(k : k) == char(0) .and. sStr2(k : k) == char(0)) then
         return
      elseif (sStr1(k : k) /= sStr2(k : k)) then
         return
      endif
      k = k + 1
   enddo
   strcmp = .TRUE.
end function strcmp


end module strutils
